home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / cnet / FPLogo03.lha / FPLOGO.REXX < prev   
OS/2 REXX Batch file  |  1995-02-05  |  8KB  |  212 lines
  1. /********** Automaticly generated header, don't edit ************************
  2.  *
  3.  * PROGRAM:       FPLOGO.rexx
  4.  *
  5.  * PURPOSE:       ANSI/ASCII Big Letter Logo creator.
  6.  *
  7.  * DATE:          05 Feb 95                           
  8.  *
  9.  * TIME:          16:16:53                           
  10.  *
  11.  * VERSION:       0
  12.  * REVISION:      3
  13.  * SUBREVISION:   0
  14.  *
  15.  * COPYRIGHT:
  16.  *
  17.  * This software is subject to the "Standard Amiga FD-Software Copyright Note"
  18.  * It is MAILWARE as defined in paragraph 4b.  For more information please
  19.  * read "AFD-COPYRIGHT" (Version 1 or higher).
  20.  *
  21.  * If you create any new fonts for use in FPLOGO, please send them to me, so I
  22.  * can include them in future updates!!
  23.  *
  24.  *
  25.  * INSTALLATION:
  26.  *
  27.  *   Create a dir in your PFILES: called FPLOGO, then copy the FPLOGO.rexx
  28.  *   and the ANSIFont dir to this PFILES:FPLOGO/
  29.  *
  30.  *   Add this to your BBSMENU under '2; Available everywhere':
  31.  *
  32.  *      LOGO    | #0PFILES:FPLOGO/FPLOGO.rexx}
  33.  *
  34.  *   You (and your users) can now create (and download) fancy logos or 
  35.  *   signatures, by typing LOGO at any prompt.
  36.  *
  37.  *
  38.  * LOG:
  39.  * 
  40.  *  05 Feb 95 Fixed a small bug in the save routine, and added Install docs.
  41.  *  02 Dec 94 Added main GFX screen and cleaned up some code. 
  42.  *  25 Nov 94 First Version.
  43.  * 
  44.  * ==========================================================================
  45.  *
  46.  *   Another
  47.  *        _____ __    __  __ __  __     ___   ____   __ __  __ ______
  48.  *       / ___// /   / / / / \ \/ /    / _ \ / __ \ / //  \/ //_  __/
  49.  *      / __/ / /__ / /_/ /  /   /    / ___// /_/ // // /\  /  / /
  50.  *     /_/   /____/ \____/  /_/\_\   /_/    \____//_//_/ /_/  /_/    
  51.  *
  52.  *                          P R O D U C T I O N
  53.  *
  54.  *     Call +45 3526-2527    FIDO 2:235/202.0    CLINK 912:2000/4.0
  55.  *
  56.  ***************************************************************************/
  57.  
  58. /* revision string for the version command. */
  59. version="$VER: FPLOGO 0.3 (05.02.95)"
  60.  
  61. options results;signal on error;signal on syntax;signal on ioerr
  62. if ~show('l','rexxsupport.library') then if ~addlib('rexxsupport.library',0,-30,0) then exit
  63. getuser 47;local=result=-1
  64. getuser 23;port=result
  65. getuser 1311992;pfdir=result;fontpath=pfdir'ANSIFont/'    /* Path to AFNT fonts */
  66. getuser 1100468;mx=(result-5)*3                            /* max numbers to show */
  67. mx=30;nu=1;spa=0                                        /* Default spacing */
  68. text='';wdir='RAM:FPF'port;wfil=wdir'/FPLOGO.TXT'
  69.  
  70. transmit 'f1q1'
  71. transmit '               c9ÜÛÛÛÛÛÛÛÜ'
  72. transmit '               ÛÛÛÛ  ßßß'
  73. transmit '               ÛÛÛÛÛÛÛÜ  cbÖÄÄ·  cdÜÜÜ     caÛÛßßßßßÛ'
  74. transmit '               c9ÛÛÛÛßßß   cbÇÄĽ  cdÛ Û     caÛÛ    ÛÛ  Úc2ËÍcaÍÍËc2¿ q1ÚÂÄ¿'
  75. transmit '               c9ÛÛÛÛ      cbº     cdÛ ÛÜÜÜÜ caÛÛ    ÛÛ  cf³q1º cfÉÍËq1¿ ³³ ³'
  76. transmit '               c9ßÛÛß      cbР    cdÛÜÜÜÜÜÛ caÛÛÜÜÜÜÜÛ  c9Àc1ÊÍc9ÍÍÊc1Ù q1ÀÁÄÙn2'center('The ONLINE Logo Creator!!',78)
  77. transmit 'n1c4'center('FPLOGO v0.2 by PMK.    Flux Point Amiga BBS +45 3526 2527',78)'n1q1'
  78. transmit 'n1NOTE: Use LOWERCASE letters, since very few fonts has UPPER/LOWERCASE!'
  79. call makedir(wdir);call NEWTEXT2;call LOADAFNT(REQUEST(fontpath));call SHOWAFNT
  80.  
  81. do forever
  82.     getchar;key=CHECK(result)
  83.     select
  84.         when key='S' then do;call SPACING;call SHOWAFNT;end
  85.         when key='T' then do;call NEWTEXT;call SHOWAFNT;end
  86.         when key='F' then do;call LOADAFNT(REQUEST(path));spa=0;call SHOWAFNT;end
  87.         when key='D' then do;call SAVEPART;call SHOWAFNT;end
  88.         when key='A' then do;call ADDPART;call SHOWAFNT;end
  89.         when key='V' then do;call VIEWPART;call SHOWAFNT;end
  90.         when key='Q' then leave
  91.         otherwise nop
  92.     end
  93. end
  94.  
  95. BYE:;if exists(wfil) then do
  96.     prompt 1 noyes 'f1n2Do you want to download the logo you just made [c2Noq1]? '
  97.     if CHECK(result)='Yes' then call SAVEPART
  98.     call delete(wfil)
  99. end
  100. call delete(wdir);transmit 'f1n1Bye....';exit
  101.  
  102. SPACING:;transmit 'n1Spacing between chars [0-9]? L1305640#'spa'}I68 1}'
  103. getuser 70;spa=CHECK(result);if spa<0|spa>9 then spa=0;return
  104.  
  105. NEWTEXT:;transmit 'n1Available chars in 'fnam'n1'ach
  106. NEWTEXT2:;sendstring 'n1Enter text to usen1: L1305640#'text'}I4 40}';getuser 70;text=CHECK(result)
  107. if text='' then signal BYE;return
  108.  
  109. VIEWPART:;if exists(wfil) then sendstring 'f1* 'wfil'}' 
  110. else transmit 'f1n2No logo file made yet!'
  111. transmit 'q1n1Press a key to return to main.g0';return
  112.  
  113. ADDPART:;transmit 'f1n1Adding text to logo...n1'
  114. call open(1,wfil,word('W A',exists(wfil)+1))
  115. do a=1 to hi;transmit fin.a;call writeln(1,fin.a);end;call close(1)
  116. transmit 'q1n1Press a key to return to main.g0';return
  117.  
  118. SAVEPART:;transmit 'f1';if exists(wfil) then do
  119.     if local then do
  120.         prompt 25 normal 'n1Copy to path: ';cdir=CHECK(result)
  121.         if right(cdir,1)~='/'&right(cdir,1)~=':' then do
  122.             sendstring 'n1Not a legal Pathname!! - Press a key to continue.g0';return;end
  123.         else do
  124.             sendstring 'Copying logo file to 'cdir
  125.             address command 'copy 'wfil' to 'cdir
  126.         end
  127.     end
  128.     else xdn wfil
  129.     call delete(wfil)
  130. end
  131. else transmit 'n1No logo file made yet!'
  132. transmit 'n1Press a key to return to main.g0';return
  133.  
  134.  
  135. SHOWAFNT:;fin.=''
  136. transmit 'f1cfz4'left(fnam,78)'n1z4'left(fcre,78)'n1z4'left('Type    : 'word('MONO COLOR',ct+1),78)'n1z4'left('Text    : 'text,78)'q1n1'
  137. do i=1 to length(text)
  138.     c=c2d(substr(text,i,1))+1;if substr(legal,c,1)='*' then do
  139.         do b=1 to hi;fin.b=fin.b||char.c.b||copies(' ',spa);end
  140.     end
  141. end
  142. do a=1 to hi;transmit fin.a;end
  143. transmit 'n1q1z4cf'left('  [c3Acf]dd to Logo   [c3Dcf]ownload   [c3Fcf]ont   [c3Scf]pacing   [c3Tcf]ext   [c3Vcf]iew   [c1Qcf]uit',120)'q1'
  144. return
  145.  
  146. LOADAFNT:;arg afnt;if ~open(1,afnt,'R') then signal BYE
  147. sendstring 'f1Loading '
  148. fnam=readln(1);fcre=readln(1);z=readln(1);parse var z wi' 'hi' 'ba' 'ct .
  149. z=readln(1);z=readln(1);legal=readln(1);z=readln(1);ach=''
  150. do a=1 to length(legal)
  151.     if substr(legal,a,1)='*' then do
  152.         sendstring '.';ach=ach||d2c(a-1);do b=1 to hi;char.a.b=readln(1);end
  153.     end
  154. end
  155. call close(1);return
  156.  
  157. REQUEST:;arg path
  158. do forever
  159.     di=showdir(path,'D');do a=2 to words(di)+1;it.a=word(di,a-1)'/';end
  160.     fi=showdir(path,'F');do b=a to a+words(fi);it.b=word(fi,b-a+1);end
  161.     it=b-2;mset=it%mx+1;it.1=word('<<Parent <Root>',(nu=1)+1);set=0;file=1
  162.     do until file~=1
  163.         p=1;s=p+set*mx;file=''
  164.         transmit 'f1z4c7 'centre('Contents of directory "'path'"',78)'q1'
  165.         do a=s to it for mx;sendstring left(it.a,22)substr('   n1',(a//3=0)*3+1,3);end
  166.         sendstring at(mx/3+2,1)'z4c7 'centre('Cursorkeys to Move, RETURN to Select.       Page 'set+1' of 'mset,78)'q1n1'at(p%3+2,(p//3-1)*26)'r1'it.s'r0'
  167.         tz=a-s
  168.         do while file=''
  169.             key=GETCURSOR();select
  170.                 when key='2'&p<tz-2 then p=ccur(3)
  171.                 when key='4'&p>1 then p=ccur(-1)
  172.                 when key='6'&p<tz then p=ccur(1)
  173.                 when key='8'&p>3 then p=ccur(-3)
  174.                 when key='2'&tz+set*mx<it then do;set=set+1;file=1;end
  175.                 when key='8'&p~=s then do;set=set-1;file=1;end
  176.                 when key='5' then file=it.s
  177.                 when key='!' then signal BYE /* Panic Exit! */
  178.                 otherwise nop /*sendstring at(1,1)'r1'key'r0'*/
  179.             end
  180.         end
  181.     end
  182.     
  183.     select
  184.         when file=it.1 then do
  185.             if nu~=1 then do
  186.                 nu=nu-1;tp=left(path,length(path)-1);
  187.                 path=left(path,max(lastpos('/',tp),lastpos(':',tp)))
  188.             end
  189.         end
  190.         when right(file,1)='/' then do;nu=nu+1;path=path||file;end
  191.         otherwise leave
  192.     end
  193. end
  194. return path||file
  195.  
  196. CCUR:
  197. sendstring at((p-1)%3+2,((p-1)//3)*25+1)it.s;p=p+ARG(1);s=p+set*mx
  198. sendstring at((p-1)%3+2,((p-1)//3)*25+1)'r1'it.s'r0';return p
  199. AT:;return ''arg(1)';'arg(2)'H'
  200.  
  201. GETCURSOR: procedure;do until key~='NOCHAR';maygetchar;key=result;end
  202.     if key='1B'x then do 2;maygetchar;key=result;end;else if key='D'x then return '5';else return upper(key)
  203.     if key='A' then return '8';if key='B' then return '2';if key='C' then return '6';if key='D' then return '4'
  204.   return upper(key)
  205.  
  206. CHECK:;if ARG() & ARG(1)~='###PANIC' then return ARG(1)
  207. getcarrier;if result='TRUE' then if ARG() then return ARG(1);else return
  208. call delete(wfil);call delete(wdir);logentry 'Lost Carrier!!';bufferflush;exit
  209.  
  210. ERROR:;IOERR:;SYNTAX:;em='Error in line: 'sigl' Code: 'errortext(rc);
  211. logentry em;transmit em;bufferflush;exit
  212.